home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PBLIB1 / UNITS / PBWIND.PAS < prev    next >
Pascal/Delphi Source File  |  1994-05-03  |  12KB  |  421 lines
  1. UNIT PbWIND;
  2.  
  3. INTERFACE
  4.  
  5. uses CRT, PbCRT, PbMISC, PbOBJS;
  6.  
  7. {
  8. Description : CRT windows
  9.  
  10. Author      : Howard Richoux
  11. Date        : 1/20/94
  12. Last revised: 2/21/94 - added PopUp logic use PopUp instead of DrawFrame
  13.               2/21/94 - added DisplayTextFile
  14. Application : IBM PC and compatibles, done in Turbo Pascal 7
  15. Status      : Placed in the Public Domain by HNR Software 1/29/1994
  16. Published in: none
  17. }
  18.  
  19.  
  20. type WINDOW_object = object
  21.        x1,y1,x2,y2 : byte;       { define box }
  22.        ul,ur,ll,lr : char;       { corner characters }
  23.        ls,rs,ts,bs : char;       { top,sides,bottom characters }
  24.        border      : boolean;
  25.        active      : boolean;
  26.        scrollflag  : boolean;    { internal bookkeepint }
  27.        saveflag    : boolean;
  28.        lines       : STRA_object;
  29.        CRTSave     : CRTSaveRec;
  30.        curr,linewidth,numlines  : integer;
  31.        currpage           : integer;
  32.        cursx,cursy        : byte;         { whenever }
  33.        cursxsav, cursysav, attrsave : byte;  { Init time }
  34.        toplbl,botlbl      : string[40];
  35.        visfirst,vislast   : integer;
  36.  
  37.        Procedure init(xx1,yy1,xx2,yy2 : byte; savelines : integer);
  38.        Procedure ReCompute;
  39.        Procedure ReFreshScreen;
  40.        Procedure SetCornerChars(uul,uur,lll,llr : char);
  41.        Procedure SetSideChars(lls,rrs,tts,bbs : char);
  42.        Procedure SetLabels(topl,botl : string);
  43.        Procedure BigWindow;           { 1,1,80,25   - absolute coordinates }
  44.        Procedure SmallWindow;         { x1,y1,x2,y2 - relative coordinates }
  45.        Procedure StretchWindow;       { special y2 for writing last line}
  46.        Procedure ClrScr;              { Data window ONLY }
  47.        Procedure OUTln(s : string);
  48.        Function  ScreenLine    (y : integer) : integer;
  49.        Procedure DisplayLineY  (x,y : integer);
  50.        Procedure OUTXY         (x,y : integer; s : string);
  51.        Procedure displaypagefromN(l : integer);
  52.        Procedure DrawFrame;
  53.        Procedure PopUp;
  54.        Procedure load (filename : string);
  55.        Procedure SaveCursor;
  56.        Procedure RestoreCursor;
  57.        Procedure Scroll;
  58.        Procedure ScrollBack1;
  59.        Procedure pause;
  60.        Procedure done;
  61.        end;
  62.  
  63.  
  64.  
  65. Procedure DisplayTextFile(filename : string; x0,y0,x1,y1,c : byte);
  66.             {[WINDOW] Displays a file in a window (remember 1,1,80,24 max)}
  67.  
  68.  
  69.  
  70. {SECTION .ZIMPLEMENTATION }
  71. IMPLEMENTATION
  72.  
  73. Procedure WINDOW_object.init(xx1,yy1,xx2,yy2 : byte; savelines : integer);
  74.      begin
  75.      x1 := xx1; y1 := yy1; x2 := xx2; y2 := yy2;
  76.      lines.init(savelines);
  77.      SetCornerChars(chr(201),chr(187),chr(200),chr(188));
  78.      SetSideChars(chr(186),chr(186),chr(205),chr(205));
  79.      SetLabels(' <toplabel> ',' <bottomlabel> ');
  80.      cursxsav := CRT.whereX; cursysav := CRT.whereY;  Attrsave := CRT.TEXTATTR;
  81.      curr     := 1; currpage := 1;
  82.      visfirst := 1;
  83.      border := true;
  84.      active := true;
  85.      scrollflag := false;
  86.      saveflag := true;
  87.      ReCompute;
  88.      end;
  89.  
  90.  
  91. Procedure WINDOW_object.ReCompute;
  92.      begin
  93.      linewidth := (x2 - x1)+1;
  94.      numlines := (y2 - y1)+1;
  95.      if border then
  96.           begin
  97.           linewidth := linewidth - 2;
  98.           numlines := numlines - 2;
  99.           end;
  100.      if visfirst < 1 then visfirst := 1;
  101.      if visfirst > lines.arraymax then visfirst := lines.arraymax;
  102.      vislast := visfirst + numlines - 1;
  103.      if vislast > lines.arraymax then vislast := lines.arraymax;
  104.      end;
  105.  
  106.  
  107. Procedure WINDOW_object.done;
  108.      begin
  109.      lines.done;
  110.      RestoreCRT(CRTSave);      {PbCRT will figure out if actually saved }
  111.      CRT.window(1,1,80,25);    {make full screen }
  112.      CRT.TEXTATTR := attrsave; {restore text colors }
  113.      CRT.gotoxy(cursxsav,cursysav);
  114.      end;
  115.  
  116.  
  117. Procedure WINDOW_object.pause;
  118. var ch : char;
  119.      begin
  120.      while not keypressed do begin end;
  121.      ch := readkey;
  122.      end;
  123.  
  124.  
  125. Procedure WINDOW_object.BigWindow; { 1,1,80,25   - absolute coordinates }
  126.      begin
  127.      if not active then exit;
  128.      CRT.window(1,1,80,25);   {make full screen }
  129.      end;
  130.  
  131.  
  132. Procedure WINDOW_object.SmallWindow;    { relative coordinates }
  133.      begin
  134.      if not active then exit;
  135.      if border then
  136.           CRT.window(x1+1,y1+1,x2-1,y2-1)
  137.      else CRT.window(x1,y1,x2,y2);
  138.      end;
  139.  
  140.  
  141. Procedure WINDOW_object.StretchWindow;    { relative coordinates }
  142.      begin
  143.      if not active then exit;
  144.      if border then
  145.           CRT.window(x1+1,y1+1,x2-1,y2)
  146.      else CRT.window(x1,y1,x2,y2);
  147.      end;
  148.  
  149.  
  150. Procedure WINDOW_object.ClrScr;
  151.      begin
  152.      scrollflag := false;
  153.      if not active then exit;
  154.      SmallWindow;
  155.      CRT.Clrscr;
  156.      end;
  157.  
  158.  
  159. Procedure WINDOW_object.SaveCursor;
  160.      begin
  161.      cursx := CRT.whereX;
  162.      cursy := CRT.whereY;
  163.      end;
  164.  
  165.  
  166. Procedure WINDOW_object.RestoreCursor;
  167.      begin
  168.      CRT.gotoXY(cursx,cursy);
  169.      end;
  170.  
  171.  
  172. Procedure WINDOW_object.SetCornerChars(uul,uur,lll,llr : char);
  173.      begin
  174.      ul := uul; ur := uur; ll := lll; lr := llr;
  175.      end;
  176.  
  177.  
  178. Procedure WINDOW_object.SetSideChars(lls,rrs,tts,bbs : char);
  179.      begin
  180.      ls := lls; rs := rrs; ts := tts; bs := bbs;
  181.      end;
  182.  
  183.  
  184. Procedure WINDOW_object.SetLabels(topl,botl : string);
  185. var s : string[60];
  186.      begin
  187.      if length(topl) < (linewidth -3) then toplbl := topl
  188.      else toplbl := leftstr(topl,linewidth-4);
  189.      if length(botl) < (linewidth -3) then botlbl := botl
  190.      else botlbl := leftstr(botl,linewidth-4);
  191.      end;
  192.  
  193.  
  194. Procedure WINDOW_object.DrawFrame;
  195. var i,l:integer;
  196.      begin
  197.      if not active then exit;
  198.      if not border then exit;
  199.      BigWindow; {Use ABSOLUTE coordinates }
  200.      PromptColor;
  201.      CRT.gotoxy(x1,y1);
  202.      write(ul);
  203.      for i:=x1+1 to x2-1 do write(ts);  {top row}
  204.      write(ur);
  205.      for i:=y1+1 to y2-1 do
  206.          begin
  207.          CRT.gotoxy(x1,i);      write(ls);
  208.          CRT.gotoxy(x2,i);      write(rs);
  209.          end;
  210.      CRT.gotoxy(x1,y2);         write(ll);
  211.      for i:=x1+1 to x2-1 do write(bs);  {bottom row}
  212.      write(lr);
  213.  
  214.      { top and bottom labels }
  215.      DataColor;
  216.      if toplbl <> '' then
  217.           begin
  218.           l := 1;
  219.           if length(toplbl) < (linewidth - 2) then
  220.                l := ((x1 + (linewidth div 2)) - (length(toplbl) div 2)) - 1;
  221.           CRT.gotoxy(l,y1);
  222.           write(toplbl);
  223.           end;
  224.      if botlbl <> '' then
  225.           begin
  226.           l := 1;
  227.           if length(botlbl) < (linewidth - 2) then
  228.                l := ((x1 + (linewidth div 2)) - (length(botlbl) div 2)) - 1;
  229.           CRT.gotoxy(l,y2);
  230.           write(botlbl);
  231.           end;
  232.      end;
  233.  
  234.  
  235. Procedure WINDOW_object.PopUp;
  236.      begin
  237.      if not active then exit;
  238.      CRT.window(x1,y1,x2,y2);    { set to gross window size }
  239.      SaveCRT(CRTSave);
  240.      DrawFrame;
  241.      SmallWindow;
  242.      ClrScr;
  243.      end;
  244.  
  245.  
  246. Procedure WINDOW_object.load(filename : string);
  247.      begin
  248.      lines.load(filename);
  249.      end;
  250.  
  251.  
  252. Procedure WINDOW_object.ScrollBack1;
  253.      begin
  254.      if not active then exit;
  255.      DataColor;
  256.      ScrollDown(1,x1+1,y1+1,x2-1,y2-1,TextAttr);
  257.      end;
  258.  
  259.  
  260. Procedure WINDOW_object.Scroll;
  261.      begin
  262.      if not active then exit;
  263.      DataColor;
  264.      if scrollflag then
  265.          ScrollUp(1,x1+1,y1+1,x2-1,y2-1,TextAttr);
  266.      end;
  267.  
  268.  
  269. Function WINDOW_object.ScreenLine(y : integer) : integer;
  270. var yy : integer;
  271.      begin
  272.      yy := 0;
  273.      if y >= visfirst then
  274.           begin
  275.           yy := (y - visfirst) + 1;
  276.           if yy > vislast then yy := 0;
  277.           end;
  278.      ScreenLine := yy;
  279.      end;
  280.  
  281.  
  282. Procedure WINDOW_object.DisplayLineY(x,y : integer);
  283. var xx,yy, scrnY : integer;
  284.     s            : string;
  285.      begin
  286.      xx := x; yy := y;
  287.      if y > lines.arraymax then yy := lines.arraymax;
  288.      if y < 1 then yy := 1;
  289.      if active then
  290.           begin
  291.           s := lines.fetchN(yy);
  292.                               {+' ['+integerstr(visfirst,3)+
  293.                                '  '+integerstr(vislast,3)+']'; }
  294.           scrnY := ScreenLine(yy);
  295.           if scrnY > 0 then
  296.                begin
  297.                StretchWindow;
  298.                DataColor;
  299.                CRT.gotoxy(xx,scrnY);
  300.                write(leftstr(s,(linewidth-xx)+1));
  301.                CRT.gotoxy(linewidth,scrnY);
  302.                end;
  303.           end;
  304.      end;
  305.  
  306.  
  307. Procedure WINDOW_object.OUTXY(x,y : integer; s : string);
  308. var xx,yy, scrnY : integer;
  309.      begin
  310.      yy := y; xx := x;
  311.      if y > lines.arraymax then yy := lines.arraymax;
  312.      if y < 1 then yy := 1;
  313.      if saveflag then lines.storeN(yy,s);
  314.      DisplayLineY(xx,yy);
  315.      end;
  316.  
  317.  
  318.  
  319. Procedure WINDOW_object.displaypagefromN(l : integer);
  320. var i,n,yy   : integer;
  321.     s       : string;
  322.      begin
  323.      SmallWindow;
  324.      clrscr;
  325.      visfirst := l;
  326.      recompute;
  327.      for n := visfirst to vislast do
  328.           begin
  329.           DisplayLineY(1,n);
  330.           end;
  331.      end;
  332.  
  333.  
  334. Procedure WINDOW_object.OUTln(s : string);
  335.      begin
  336.      if saveflag then lines.appendpush(s);
  337.      if curr < numlines then
  338.           begin
  339.           if active then
  340.                begin
  341.                SmallWindow;
  342.                CRT.gotoxy(1,curr); write(leftstr(s,linewidth));
  343.                gotoxy(linewidth,curr);
  344.                end;
  345.           inc(curr);
  346.           visfirst := curr - numlines + 1;
  347.           recompute;
  348.           end
  349.      else begin
  350.           Scroll;
  351.           scrollflag := true;
  352.           if active then
  353.                begin
  354.                StretchWindow;
  355.                CRT.gotoxy(1,curr); write(leftstr(s,linewidth));
  356.                gotoxy(linewidth,curr);
  357.                end;
  358.           visfirst := curr - numlines + 1;
  359.           recompute;
  360.           end;
  361.      end;
  362.  
  363.  
  364. Procedure WINDOW_object.RefreshScreen;
  365. var i,j,k : integer;
  366.     s     : string;
  367.      begin
  368.      active := true;
  369.      ReCompute;
  370.      DrawFrame;
  371.      ClrScr;
  372.      displayPageFromN(visfirst);
  373.      end;
  374.  
  375.  
  376.  
  377.  
  378. Procedure DisplayTextFile(filename : string; x0,y0,x1,y1,c : byte);
  379. var cmd,lnstat : string[20];
  380. var q   : WINDOW_object;
  381.      begin
  382.      cmd := '?CONTINUE';
  383.      SetColorScheme(c);
  384.      q.init(x0,y0,x1,y1,1000);
  385.      q.setlabels(' '+filename+' ','');
  386.      q.PopUp;
  387.      q.smallwindow;
  388.      q.load(filename);
  389.      lnstat := '(' + integerstr(q.visfirst,4) + '/' +
  390.                      integerstr(q.lines.count,4) + ')';
  391.      removeblanks(lnstat);
  392.      q.setlabels(' '+filename+' ',
  393.                  ' Pg&Arr to view, Esc to quit '+lnstat+' ');
  394.      q.refreshscreen;
  395.      while (cmd <> '?ESCAPE')  and (cmd <> 'QUIT') do
  396.           begin
  397.           GetKeyCmd(cmd);
  398.           if      cmd = '?UPARR'   then dec(q.visfirst)
  399.           else if cmd = '?DOWNARR' then inc(q.visfirst)
  400.           else if cmd = '?DOWN'    then q.visfirst := q.visfirst + q.numlines
  401.           else if cmd = '?UP'      then q.visfirst := q.visfirst - q.numlines
  402.           else if cmd = '?HOME'    then q.visfirst := 1
  403.           else if cmd = '?END'     then q.visfirst := (q.lines.count-q.numlines)+1
  404.           else begin
  405.                end;
  406.           lnstat := '(' + integerstr(q.visfirst,4) + '/' +
  407.                           integerstr(q.lines.count,4) + ')';
  408.           removeblanks(lnstat);
  409.           q.setlabels(' '+filename+' ',
  410.                       ' Pg&Arr to view, Esc to quit '+lnstat+' ');
  411.           q.refreshscreen;
  412.           end;
  413.      q.done;
  414.      end;
  415.  
  416.  
  417.  
  418. {SECTION   ZInitialization }
  419.      begin {Initialization}
  420.      end.
  421.